home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / vsc92nov.zip / gcstat.c < prev    next >
Text File  |  1992-11-02  |  2KB  |  83 lines
  1. /*
  2.  * gcstat.c -- Implementation of gc_statistics_proc for Scheme
  3.  *
  4.  * (C) m.b (Matthias Blume), Mon May 25 11:38:25 MET DST 1992, HUB/Ger
  5.  *         Humboldt-University of Berlin, Germany
  6.  */
  7.  
  8. # ident "@(#)gcstat.c    (C) M.Blume, Humboldt-Uni Berlin, 1.4"
  9.  
  10. # include <stdio.h>
  11.  
  12. # include "storage.h"
  13. # include "Cont.h"
  14. # include "Code.h"
  15. # include "Number.h"
  16. # include "Vector.h"
  17. # include "speccont.h"
  18. # include "mode.h"
  19. # include "except.h"
  20.  
  21. # if (1000 < CLOCKS_PER_SEC)
  22. # define CLK2MS(clk) ((clk)/(CLOCKS_PER_SEC/1000))
  23. # else
  24. # define CLK2MS(clk) (((clk)*1000)/CLOCKS_PER_SEC)
  25. # endif
  26.  
  27. void gc_statistics_proc (
  28.   size_t gbc, size_t nobj, size_t min, size_t total, size_t used, clock_t clk)
  29. {
  30.   void *gcmode = ScmMode (SCM_GC_STRATEGY_MODE);
  31.   void *tmp;
  32.   ScmVector *vect;
  33.   static size_t previous_min = 0;
  34.  
  35.   clk = CLK2MS (clk);
  36.  
  37.   if (gcmode == NULL) {
  38.     fprintf (stderr, "GC: called after %lu getbytes-calls,\n"
  39.              "    found %lu active objects in %ld Milliseconds\n"
  40.              "    memory usage: %lu of %lu heap elements (%lu%%)\n",
  41.        (unsigned long) gbc,
  42.        (unsigned long) nobj,
  43.        (long) clk,
  44.        (unsigned long) used, (unsigned long) total,
  45.        total == 0 ? 100 : (unsigned long) ((used * 100) / total));
  46.     if (min < previous_min) {
  47.       previous_min = min;
  48.       reset ("Reset due to memory allocation problem");
  49.     }
  50.     if (2 * used > min)
  51.       gc_set_min_heap_size (2 * used);
  52.   } else {
  53.     vect = NewScmVector (8);
  54.     ScmPush (vect);
  55.     gcmode = ScmMode (SCM_GC_STRATEGY_MODE);
  56.     vect = ScmPeek ();
  57.     vect->array [0] = gcmode;
  58.     tmp = ScmIntToExactNumber (gbc);
  59.     vect = ScmPeek ();
  60.     vect->array [1] = tmp;
  61.     tmp = ScmIntToExactNumber (nobj);
  62.     vect = ScmPeek ();
  63.     vect->array [2] = tmp;
  64.     tmp = ScmIntToExactNumber (min);
  65.     vect = ScmPeek ();
  66.     vect->array [3] = tmp;
  67.     tmp = ScmIntToExactNumber (previous_min);
  68.     vect = ScmPeek ();
  69.     vect->array [4] = tmp;
  70.     tmp = ScmIntToExactNumber (total);
  71.     vect = ScmPeek ();
  72.     vect->array [5] = tmp;
  73.     tmp = ScmIntToExactNumber (used);
  74.     vect = ScmPeek ();
  75.     vect->array [6] = tmp;
  76.     tmp = ScmIntToExactNumber ((long) clk);
  77.     vect = ScmPop ();
  78.     vect->array [7] = tmp;
  79.     ScmRegisterInterrupt (SCM_VM_GC_STRAT_CONT, vect);
  80.   }
  81.   previous_min = min;
  82. }
  83.